Developer CD Series 1996 May: Tool Chest

home *** CD-ROM | disk | FTP | other *** search

/ Developer CD Series 1996 May: Tool Chest / Developer CD Series May 1996 (Tool Chest) (Apple Computer) (1996).iso / Sample Code / Snippets / Testing & Debugging / Gestalt dcmd / Gestalt_dcmd.p < prev next >

Wrap

Text File | 1992-07-15 | 24.9 KB | 709 lines | [TEXT/MPS ]

unit Gestalt_dcmd; (* The following MPW commands will build the dcmd and copy it to the "Debugger Prefs" file in the System folder. The dcmd's name in MacsBug will be the name of the file built by the Linker. set dc "{perso}Gestalt dcmd:"; export dc directory "{dc}" Pascal Gestalt_dcmd.p Link "{libraries}"dcmdGlue.a.o Gestalt_dcmd.p.o "{libraries}"interface.o "{libraries}"runtime.o "{plibraries}"paslib.o -o Gestalt BuildDcmd Gestalt 127 directory "{mpw}" *) interface uses MemTypes, OsUtils, dcmd; {$R-} {$OV-} { Public declaration for dcmdGlue. Must be in every dcmd. The name cannot be changed. } procedure CommandEntry(paramPtr: dcmdBlockPtr); implementation const kWholeSelectors1 = 'versaddralisatlka/uxctbvdbacedtnevntfold'; kWholeSelectors2 = 'fontfpu hdwrhelpkbd lmemlrammiscmmu nmgr'; kWholeSelectors3 = 'os pgszppc powrprocprtyqd ram rsrcscri'; kWholeSelectors4 = 'scr#snd te tmgrvm machrom romvsysvconn'; kWholeSelectors5 = 'crm fxfrser termditleasyfs nluppop!stdf'; kWholeSelectors6 = 'micnostttbttxttt'; procedure DoDcmdHelp; begin dcmdDrawLine('Gestalt [selector]'); dcmdDrawLine(' Display Gestalt values, no selector means all values.'); dcmdDrawLine(' Version 1.0 by Eric SIMENEL, Apple Computer France.'); dcmdDrawLine(' Some selectors are recognized and have a special processing.'); dcmdDrawLine(' Other selectors are sent thru to Gestalt, and you get the response if any.'); end; function MyGestalt(selector: OSType; VAR response: Longint): OsErr; inline $202F, $0004, $A1AD, $226F, $0000, $2288, $3F40, $0008, $508F; { 202F 0004 ' /..' MOVE.L $0004(A7),D0 A1AD '..' DC.W $A1AD ; OS 00AD is Gestalt trap 226F 0000 '"o..' MOVEA.L $0000(A7),A1 2288 '".' MOVE.L A0,(A1) 3F40 0008 '?@..' MOVE.W D0,$0008(A7) 508F 'P.' ADDQ.L #$8,A7 } procedure NumberToHex(number: Longint; var hex: Str255); var digits: Str255; n: Integer; begin digits := '0123456789ABCDEF'; hex := '00000000'; for n := 8 downto 1 do begin hex[n] := digits[1 + (number mod 16)]; number := number div 16; end; end; procedure NumberToShortHex(number: Longint; var hex: Str255); var digits: Str255; n: Integer; begin digits := '0123456789ABCDEF'; hex := '0000'; for n := 4 downto 1 do begin hex[n] := digits[1 + (number mod 16)]; number := number div 16; end; end; procedure NumberToShortHex2(number: Longint; var hex: Str255; leadingzero: Boolean); var digits: Str255; n: Integer; begin digits := '0123456789ABCDEF'; hex := '00'; for n := 2 downto 1 do begin hex[n] := digits[1 + (number mod 16)]; number := number div 16; end; if not leadingzero then if hex[1] = '0' then begin hex[1] := hex[2]; hex[0] := Chr(1); end; end; procedure NumberToString(number: Longint; var astr: Str255); var digits: Str255; n, m: Integer; minus: Boolean; begin minus := (number < 0); if minus then number := -number; digits := '0123456789'; astr := ' '; for n := 10 downto 1 do begin astr[n] := digits[1 + (number mod 10)]; number := number div 10; end; n := 1; while (astr[n] = '0') and (n < 10) do n := n+1; if minus then digits[0] := Chr(12-n) else digits[0] := Chr(11-n); if minus then m := 1 else m := 0; while n <= 10 do begin m := m+1; digits[m] := astr[n]; n := n+1; end; if minus then digits[1] := '-'; astr := digits; end; procedure CommandEntry(paramPtr: dcmdBlockPtr); var ch: Char; str: Str255; procedure AskASelector(theSelector: Str255); var i, j, k: Integer; aSelector, aKnownSelector: OSType; response: Longint; theErr: OsErr; procedure DispVersion; begin dcmdDrawString(', v.'); NumberToShortHex2(response div 256, str, false); dcmdDrawString(str); dcmdDrawString('.'); NumberToShortHex2(response mod 256, str, true); dcmdDrawString(str); end; begin dcmdDrawLine(theSelector); for i := 1 to 4 do aSelector[i] := theSelector[i]; i := -1; for j := 1 to 10 do begin for k := 1 to 4 do aKnownSelector[k] := kWholeSelectors1[4*(j-1)+k]; if aKnownSelector = aSelector then i := j; end; if i = -1 then for j := 1 to 10 do begin for k := 1 to 4 do aKnownSelector[k] := kWholeSelectors2[4*(j-1)+k]; if aKnownSelector = aSelector then i := j+10; end; if i = -1 then for j := 1 to 10 do begin for k := 1 to 4 do aKnownSelector[k] := kWholeSelectors3[4*(j-1)+k]; if aKnownSelector = aSelector then i := j+20; end; if i = -1 then for j := 1 to 10 do begin for k := 1 to 4 do aKnownSelector[k] := kWholeSelectors4[4*(j-1)+k]; if aKnownSelector = aSelector then i := j+30; end; if i = -1 then for j := 1 to 10 do begin for k := 1 to 4 do aKnownSelector[k] := kWholeSelectors5[4*(j-1)+k]; if aKnownSelector = aSelector then i := j+40; end; if i = -1 then for j := 1 to 4 do begin for k := 1 to 4 do aKnownSelector[k] := kWholeSelectors6[4*(j-1)+k]; if aKnownSelector = aSelector then i := j+50; end; case i of 1: dcmdDrawString(', Gestalt version '); 2: dcmdDrawString(', Addressing mode attrib. '); 3: dcmdDrawString(', Alias Mgr attributes '); 4: dcmdDrawString(', AppleTalk version '); 5: dcmdDrawString(', A/UX version if present '); 6: dcmdDrawString(', Comm Toolbox version '); 7: dcmdDrawString(', DB Access Mgr version '); 8: dcmdDrawString(', Edition Mgr attributes '); 9: dcmdDrawString(', AppleEvents attributes '); 10: dcmdDrawString(', Folder Mgr attributes '); 11: dcmdDrawString(', Font Mgr attributes '); 12: dcmdDrawString(', FPU type '); 13: dcmdDrawString(', Hardware attributes '); 14: dcmdDrawString(', Help Mgr attributes '); 15: dcmdDrawString(', Keyboard type '); 16: dcmdDrawString(', Low-memory area size '); 17: dcmdDrawString(', Logical RAM size '); 18: dcmdDrawString(', Miscellaneous attrib. '); 19: dcmdDrawString(', MMU Type '); 20: dcmdDrawString(', Notification Mgr attrib.'); 21: dcmdDrawString(', O/S attributes '); 22: dcmdDrawString(', Logical page size '); 23: dcmdDrawString(', PPC Toolbox attributes '); 24: dcmdDrawString(', Power Mgr attributes '); 25: dcmdDrawString(', Processor type '); 26: dcmdDrawString(', Parity attributes '); 27: dcmdDrawString(', QuickDraw version '); 28: dcmdDrawString(', Physical RAM size '); 29: dcmdDrawString(', Resource Mgr attributes '); 30: dcmdDrawString(', Script Mgr version '); 31: dcmdDrawString(', # of active script syst.'); 32: dcmdDrawString(', Sound attributes '); 33: dcmdDrawString(', TextEdit version '); 34: dcmdDrawString(', Time Mgr version '); 35: dcmdDrawString(', Virtual memory attrib. '); 36: dcmdDrawString(', Machine type '); 37: dcmdDrawString(', ROM size '); 38: dcmdDrawString(', ROM version '); 39: dcmdDrawString(', System file version '); 40: dcmdDrawString(', Connection Mgr attrib. '); 41: dcmdDrawString(', Comm resource Mgr attrib'); 42: dcmdDrawString(', File transfer Mgr arrrib'); 43: dcmdDrawString(', Serial attributes '); 44: dcmdDrawString(', Terminal Mgr attributes '); 45: dcmdDrawString(', DITL Extensions attrib. '); 46: dcmdDrawString(', Easy Access attributes '); 47: dcmdDrawString(', File system attributes '); 48: dcmdDrawString(', Standard NBP attributes '); 49: dcmdDrawString(', Popup CDEF attributes '); 50: dcmdDrawString(', Standard File attributes'); 51: dcmdDrawString(', Machine Icon '); 52: dcmdDrawString(', OS trap table base '); 53: dcmdDrawString(', Toolbox trap table base '); 54: dcmdDrawString(', Ext. TB trap table base '); end; theErr := MyGestalt(aSelector, response); if theErr <> noErr then begin NumberToString(theErr, str); dcmdDrawString(', error= '); dcmdDrawString(str); case theErr of -5550: dcmdDrawString(', No response'); -5551: dcmdDrawString(', Undefined selector'); end; end else begin NumberToString(response, str); dcmdDrawString(', response= '); dcmdDrawString(str); case i of 1:; 2: begin NumberToHex(response, str); dcmdDrawString(', '); dcmdDrawString(str); if response mod 2 = 1 then dcmdDrawLine(' booted in 32-bit mode'); response := response div 2; if response mod 2 = 1 then dcmdDrawLine(' 32-bit compatible system zone'); response := response div 2; if response mod 2 = 1 then dcmdDrawLine(' machine is 32-bit capable'); end; 3: case response of 1: dcmdDrawString(', Alias Mgr is present'); end; 4:; 5:; 6: DispVersion; 7: case response of 1: dcmdDrawString(', DB Access Mgr is present'); end; 8: case response of 1: dcmdDrawString(', Edition Mgr is present'); end; 9: case response of 1: dcmdDrawString(', AppleEvents present'); end; 10: case response of 1: dcmdDrawString(', Folder Mgr is present'); end; 11: case response of 1: dcmdDrawString(', Outline fonts present'); end; 12: case response of 0: dcmdDrawString(', no FPU present'); 1: dcmdDrawString(', Motorola 68881 present'); 2: dcmdDrawString(', Motorola 68882 present'); 3: dcmdDrawString(', Motorola 68040 built-in FPU'); end; 13: begin NumberToHex(response, str); dcmdDrawString(', '); dcmdDrawString(str); if response mod 2 = 1 then dcmdDrawLine(' VIA1 present'); response := response div 2; if response mod 2 = 1 then dcmdDrawLine(' VIA2 present'); response := response div 2; if response mod 2 = 1 then dcmdDrawLine(' RBV present'); response := response div 2; if response mod 2 = 1 then dcmdDrawLine(' ASC present'); response := response div 2; if response mod 2 = 1 then dcmdDrawLine(' SCC present'); response := response div 2; if response mod 2 = 1 then dcmdDrawLine(' OSS present'); response := response div 2; if response mod 2 = 1 then dcmdDrawLine(' SCSI DMA present'); response := response div 2; if response mod 2 = 1 then dcmdDrawLine(' SCSI present'); response := response div 2; if response mod 2 = 1 then dcmdDrawLine(' SWIM IOP present'); response := response div 2; if response mod 2 = 1 then dcmdDrawLine(' SCC IOP present'); response := response div 2; if response mod 2 = 1 then dcmdDrawLine(' Fitch memory Controller'); response := response div 2; if response mod 2 = 1 then dcmdDrawLine(' IWM/SWIM'); response := response div 2; if response mod 2 = 1 then dcmdDrawLine(' PWM disk speed buffer'); response := response div 2; if response mod 2 = 1 then dcmdDrawLine(' RAM-based sound buffer'); response := response div 2; if response mod 2 = 1 then dcmdDrawLine(' Video D/A Converter'); response := response div 2; if response mod 2 = 1 then dcmdDrawLine(' PGC (parity control)'); end; 14: case response of 1: dcmdDrawString(', Help Mgr present'); end; 15: case response of 1: dcmdDrawString(', Mac keyboard'); 2: dcmdDrawString(', Mac keyboard and keypad'); 3: dcmdDrawString(', Mac Plus keyboard'); 4: dcmdDrawString(', Extended ADB keyboard'); 5: dcmdDrawString(', Standard ADB keyboard'); 6: dcmdDrawString(', Portable Std ADB keyboard'); 7: dcmdDrawString(', Portable ISO ADB keyboard'); 8: dcmdDrawString(', ISO Std ADB keyboard'); 9: dcmdDrawString(', ISO Ext ADB keyboard'); 10: dcmdDrawString(', Elmer keyboard'); 11: dcmdDrawString(', Elmer ISO keyboard'); end; 16:; 17:; 18: begin NumberToHex(response, str); dcmdDrawString(', '); dcmdDrawString(str); if response mod 2 = 1 then dcmdDrawLine(' Scrolling Throttle'); response := response div 2; if response mod 2 = 1 then dcmdDrawLine(' Boot Globals'); response := response div 2; if response mod 2 = 1 then dcmdDrawLine(' Square Menu Bar'); end; 19: case response of 0: dcmdDrawString(', No MMU present'); 1: dcmdDrawString(', Mac II addr management unit'); 2: dcmdDrawString(', Motorola 68851 PMMU'); 3: dcmdDrawString(', Motorola 68030 built-in MMU'); 4: dcmdDrawString(', Motorola 68040 built-in MMU'); end; 20: case response of 1: dcmdDrawString(', Notification Mgr present'); end; 21: begin NumberToHex(response, str); dcmdDrawString(', '); dcmdDrawString(str); if response mod 2 = 1 then dcmdDrawLine(' System heap can grow'); response := response div 2; if response mod 2 = 1 then dcmdDrawLine(' Can return from launch'); response := response div 2; if response mod 2 = 1 then dcmdDrawLine(' Can launch from full filespec'); response := response div 2; if response mod 2 = 1 then dcmdDrawLine(' Launch control support'); response := response div 2; if response mod 2 = 1 then dcmdDrawLine(' Temp memory support present'); response := response div 2; if response mod 2 = 1 then dcmdDrawLine(' Temp memory handles are real'); response := response div 2; if response mod 2 = 1 then dcmdDrawLine(' Temp memory handles tracked'); response := response div 2; if response mod 2 = 1 then dcmdDrawLine(' IPC support is present'); response := response div 2; if response mod 2 = 1 then dcmdDrawLine(' System debugger support'); end; 22:; 23: begin NumberToHex(response, str); dcmdDrawString(', '); dcmdDrawString(str); if response = 0 then dcmdDrawLine(' PPC Toolbox present') else begin if response mod 2 = 1 then dcmdDrawLine(' PPC supports Incoming'); response := response div 2; if response mod 2 = 1 then dcmdDrawLine(' PPC supports Out Going'); response := response div $0800; if response mod 2 = 1 then dcmdDrawLine(' PPC supports real-time delivery'); response := response div 2; if response mod 2 = 1 then dcmdDrawLine(' PPC store and forward delivery'); response := response div 2; if response mod 2 = 1 then dcmdDrawLine(' PPC supports Specification of Don''t care'); end; end; 24: begin NumberToHex(response, str); dcmdDrawString(', '); dcmdDrawString(str); if response mod 2 = 1 then dcmdDrawLine(' Power Mgr is present'); response := response div 2; if response mod 2 = 1 then dcmdDrawLine(' CPU can idle'); response := response div $0800; if response mod 2 = 1 then dcmdDrawLine(' Can stop SCC clock'); response := response div 2; if response mod 2 = 1 then dcmdDrawLine(' Can turn off sound power'); end; 25: case response of 1: dcmdDrawString(', Motorola 68000'); 2: dcmdDrawString(', Motorola 68010'); 3: dcmdDrawString(', Motorola 68020'); 4: dcmdDrawString(', Motorola 68030'); 5: dcmdDrawString(', Motorola 68040'); end; 26: begin NumberToHex(response, str); dcmdDrawString(', '); dcmdDrawString(str); if response mod 2 = 1 then dcmdDrawLine(' Machine can check parity'); response := response div 2; if response mod 2 = 1 then dcmdDrawLine(' Parity RAM is installed'); end; 27: begin case (response div 256) of 0: dcmdDrawString(', Original QuickDraw'); 1: dcmdDrawString(', 8-bit Color QuickDraw'); 2: dcmdDrawString(', 32-bit Color QuickDraw'); end; DispVersion; end; 28:; 29: case response of 1: dcmdDrawString(', Partial resources functions exist'); end; 30: DispVersion; 31:; 32: begin NumberToHex(response, str); dcmdDrawString(', '); dcmdDrawString(str); if response mod 2 = 1 then dcmdDrawLine(' Stereo capability present'); response := response div 2; if response mod 2 = 1 then dcmdDrawLine(' Stereo mixing on external speaker'); response := response div 2; if response mod 2 = 1 then dcmdDrawLine(' Sound Reserved'); response := response div 2; if response mod 2 = 1 then dcmdDrawLine(' Sound I/O Manager present'); response := response div 2; if response mod 2 = 1 then dcmdDrawLine(' Sound Input hardware present'); end; 33: case response of 1: dcmdDrawString(', In MacIIci ROM'); 2: dcmdDrawString(', 6.0.4 scripts on MacIIci'); 3: dcmdDrawString(', 6.0.4 scripts on all Macs but MacIIci'); 4: dcmdDrawString(', In 6.0.5 and 7.0'); end; 34: case response of 1: dcmdDrawString(', Standard Time Mgr'); 2: dcmdDrawString(', Revised Time Mgr'); 3: dcmdDrawString(', Extended Time Mgr'); end; 35: case response of 1: dcmdDrawString(', Virtual memory present'); end; 36: case response of 1: dcmdDrawString(', Macintosh 128K'); 2: dcmdDrawString(', Macintosh XL'); 3: dcmdDrawString(', Macintosh 512K Enhanced'); 4: dcmdDrawString(', Macintosh Plus'); 5: dcmdDrawString(', Macintosh SE'); 6: dcmdDrawString(', Macintosh II'); 7: dcmdDrawString(', Macintosh IIx'); 8: dcmdDrawString(', Macintosh IIcx'); 9: dcmdDrawString(', Macintosh SE/30'); 10: dcmdDrawString(', Macintosh Portable'); 11: dcmdDrawString(', Macintosh IIci'); 13: dcmdDrawString(', Macintosh IIfx'); 17: dcmdDrawString(', Macintosh Classic'); 18: dcmdDrawString(', Macintosh IIsi'); 19: dcmdDrawString(', Macintosh LC'); end; 37:; 38: begin DispVersion; dcmdDrawString(', ROM wasn''t built in one day…'); end; 39: DispVersion; 40: begin NumberToHex(response, str); dcmdDrawString(', '); dcmdDrawString(str); if response mod 2 = 1 then dcmdDrawLine(' Connection Mgr present'); response := response div 2; if response mod 2 = 1 then dcmdDrawLine(' Connection Mgr Error String'); response := response div 2; if response mod 2 = 1 then dcmdDrawLine(' Extended I/O model present'); response := response div 2; if response mod 2 = 1 then dcmdDrawLine(' Fix to CMAddSearch present'); end; 41: case response of 1: dcmdDrawString(', Comm resource Mgr present'); end; 42: begin NumberToHex(response, str); dcmdDrawString(', '); dcmdDrawString(str); if response mod 2 = 1 then dcmdDrawLine(' File transfer Mgr present'); response := response div 2; if response mod 2 = 1 then dcmdDrawLine(' File transfer Mgr Error String'); end; 43: begin NumberToHex(response, str); dcmdDrawString(', '); dcmdDrawString(str); if response mod 2 = 1 then dcmdDrawLine(' GPIa connected to DCDa'); response := response div 2; if response mod 2 = 1 then dcmdDrawLine(' GPIa connected to RTxCa clock input'); response := response div 2; if response mod 2 = 1 then dcmdDrawLine(' GPIb connected to DCDb'); end; 44: begin NumberToHex(response, str); dcmdDrawString(', '); dcmdDrawString(str); if response mod 2 = 1 then dcmdDrawLine(' Terminal Mgr present'); response := response div 2; if response mod 2 = 1 then dcmdDrawLine(' Terminal Error String'); end; 45: case response of 1: dcmdDrawString(', DITL Extensions present'); end; 46: begin NumberToHex(response, str); dcmdDrawString(', '); dcmdDrawString(str); if response mod 2 = 1 then dcmdDrawLine(' Easy Access present, but off'); response := response div 2; if response mod 2 = 1 then dcmdDrawLine(' Easy Access "On"'); response := response div 2; if response mod 2 = 1 then dcmdDrawLine(' Easy Access "Sticky"'); response := response div 2; if response mod 2 = 1 then dcmdDrawLine(' Easy Access "Locked"'); end; 47: case response of 0: dcmdDrawString(', New HFS Dispatcher'); end; 48: case response of 1: dcmdDrawString(', Standard NBP present'); end; 49: case response of 1: dcmdDrawString(', Popup CDEF present'); end; 50: case response of 1: dcmdDrawString(', Standard File 5-8 present'); end; otherwise begin NumberToHex(response, str); dcmdDrawString(', response in hexa= '); dcmdDrawString(str); end; end; end; end; begin case paramPtr^.request of dcmdInit:; dcmdDoIt: begin if NGetTrapAddress($A1AD, OSTrap) = NGetTrapAddress($A89F, ToolTrap) then begin dcmdDrawLine('Gestalt is not implemented on this machine with this system !'); exit(CommandEntry); end; dcmdDrawLine(' '); if dcmdPeekAtNextChar = Chr($0D) then begin AskASelector('vers'); AskASelector('addr'); AskASelector('alis'); AskASelector('atlk'); AskASelector('a/ux'); AskASelector('ctbv'); AskASelector('dbac'); AskASelector('edtn'); AskASelector('evnt'); AskASelector('fold'); AskASelector('font'); AskASelector('fpu '); AskASelector('hdwr'); AskASelector('help'); AskASelector('kbd '); AskASelector('lmem'); AskASelector('lram'); AskASelector('misc'); AskASelector('mmu '); AskASelector('nmgr'); AskASelector('os '); AskASelector('pgsz'); AskASelector('ppc '); AskASelector('powr'); AskASelector('proc'); AskASelector('prty'); AskASelector('qd '); AskASelector('ram '); AskASelector('rsrc'); AskASelector('scri'); AskASelector('scr#'); AskASelector('snd '); AskASelector('te '); AskASelector('tmgr'); AskASelector('vm '); AskASelector('mach'); AskASelector('rom '); AskASelector('romv'); AskASelector('sysv'); AskASelector('conn'); AskASelector('crm '); AskASelector('fxfr'); AskASelector('ser '); AskASelector('term'); AskASelector('ditl'); AskASelector('easy'); AskASelector('fs '); AskASelector('nlup'); AskASelector('pop!'); AskASelector('stdf'); AskASelector('micn'); AskASelector('ostt'); AskASelector('tbtt'); AskASelector('xttt'); end else begin ch := dcmdGetNextParameter(str); if (ch <> Chr($0D)) or (Length(str) <> 4) then begin dcmdDrawLine('Syntax is :'); dcmdDrawLine('Gestalt [selector]'); dcmdDrawLine(' where selector is a gestalt selector such as mach or sysv.'); end else AskASelector(str); end; end; dcmdHelp: DoDcmdHelp; end; end; end.